home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / textf.arc / TEXTTEST.PAS < prev   
Pascal/Delphi Source File  |  1991-04-28  |  7KB  |  270 lines
  1. PROGRAM RLtest;
  2.   { Test program for the textf unit.
  3.     Adapted from original RLINE program written by Don Strenczewilk.
  4.     Modifications by Arthur Zatarain C'serve [73417,525]  09/24/89
  5.  
  6.     The AMZ modifications make use of objects.  The files previously
  7.     named RLINE have been renamed TEXTF to avoid conflicts.  The test
  8.     program is called TEXTTEST.
  9.  
  10.  
  11.   Does a speed comparison between FReadLn and ReadLn,
  12.        a file position/seek test,
  13.        and types a file to the screen.
  14.  
  15.   Running TEXTTEST with "RLTEST.PAS" as the command line parameter should
  16.   get you going.
  17.  
  18.   Test with different files and buffer sizes (CONST BS, below).
  19.   }
  20.  
  21.  
  22. USES DOS, CRT, textf;
  23.  
  24.  
  25.   { Global constants and variables.}
  26. CONST
  27.   BS      = 2048;            { Disk Buffer size. }
  28.  
  29. VAR
  30.   S       : STRING;          { general purpose string }
  31.   i       : Word;
  32.   TBuf    : ARRAY[1..BS] OF Char;
  33.   RF      : RFrec;     { this is now an object }
  34.   f       : Text;
  35.   fname : string[32];
  36.  
  37.  
  38.   { Timing routine.  Derived from Neil Rubenking's TIMER.PAS in LIB 4. }
  39. TYPE
  40.   OnOrOff = (On, Off);
  41.  
  42. VAR
  43.   start, time : Real;
  44.  
  45.   PROCEDURE timer(O : OnOrOff);
  46.   VAR
  47.     hour, min, sec, hun : Word;
  48.   BEGIN
  49.     GetTime(hour, min, sec, hun);
  50.     time := hour*3600+min*60+sec+hun/100;
  51.     CASE O OF
  52.       On : start := time;
  53.       Off : BEGIN
  54.               time := time-start;
  55.               Write('Time: ', time:6:2, ' ');
  56.             END;
  57.     END;
  58.   END;
  59.  
  60.  
  61. PROCEDURE ShowIOerror(i : Integer);
  62.     { Displays some of the common errors, and waits for a keypress. }
  63.   VAR
  64.     S       : STRING[80];
  65.   BEGIN
  66.     CASE i OF
  67.       0 : S := '';           { it's not an error write nothing. }
  68.       100 : S := 'Attempted to read past end of file.';
  69.       101 : S := 'Disk write error.';
  70.       102 : S := 'File not assigned.';
  71.       103 : S := 'File not opened.';
  72.       104 : S := 'File not open for input.';
  73.  
  74.       2 : S := 'File not found.';
  75.       3 : S := 'Path not found.';
  76.       4 : S := 'Too many files opened.';
  77.       5 : S := 'File access denied.';
  78.       6 : S := 'Invalid file handle.';
  79.       -1 : S := 'End Of File.'; { special EOF number, unique to FRead and FReadln }
  80.     ELSE BEGIN
  81.            Str(i, S);
  82.            S := 'IOerror '+S;
  83.          END;
  84.     END;
  85.     Write('  ', S, '  [Press any key]');
  86.     REPEAT UNTIL keypressed;
  87.     IF readkey = #0 THEN ;
  88.     writeln;
  89.   END;
  90.  
  91.   (************************************************************************)
  92.  
  93.  
  94.   PROCEDURE PrepForTimingTest(Fn : STRING);
  95.     { Opens and read Fn, before doing the FReadLn/ReadLn timing tests.
  96.     Otherwise, the order the two tests are performed produces different
  97.     results ( probably because the disk heads start in different positions,
  98.     and maybe second test benefits from using previously filled DOS buffers. }
  99.  
  100.   VAR
  101.     i       : Integer;
  102.     j       : LongInt;
  103.   BEGIN
  104.     with rf do begin
  105.       WriteLn('Reading file to prepare for timing tests..');
  106.       i := FOpen(Fn, BS, TBuf);
  107.       IF i <> 0 THEN BEGIN
  108.         ShowIOerror(i);
  109.         Halt;
  110.       END;
  111.       WHILE (FReadLn(S) = 0) DO ;
  112.       FClose;
  113.     end;
  114.   END;
  115.  
  116.  
  117.   PROCEDURE ReadLnTest(Fn : STRING);
  118.     { Time comparison between FReadLn and ReadLn }
  119.   VAR
  120.     NLines  : LongInt;
  121.   BEGIN
  122.     with rf do begin
  123.       i := FOpen(Fn, BS, TBuf);
  124.       IF i <> 0 THEN BEGIN
  125.         ShowIOerror(i);
  126.         Halt;
  127.       END;
  128.  
  129.       Write('FReadLn timing test: Reading strings from ', Fn, '.. ');
  130.       NLines := 0;
  131.       timer(On);
  132.       REPEAT
  133.         i := FReadLn(S);
  134.         IF i = 0
  135.         THEN Inc(NLines);
  136.       UNTIL i <> 0;
  137.       timer(Off); WriteLn;
  138.       Write(NLines, ' lines were read.'); ShowIOerror(i);
  139.       FClose;
  140.     end;
  141.     WriteLn;
  142.  
  143.     {Test TP ReadLn}
  144.     Assign(f, Fn);
  145.     Reset(f);
  146.     i := IoResult;
  147.     IF i <> 0 THEN BEGIN
  148.       ShowIOerror(i);
  149.       Halt;
  150.     END;
  151.     Write('ReadLn timing test: Reading strings from ', Fn, '... ');
  152.     SetTextBuf(f, TBuf);
  153.     NLines := 0;
  154.     timer(On);
  155.     REPEAT
  156.       ReadLn(f, S);
  157.       i := IoResult;
  158.       IF i = 0
  159.       THEN Inc(NLines);
  160.     UNTIL EOF(F) OR (i <> 0);
  161.     timer(Off); WriteLn;
  162.     WriteLn(NLines, ' lines were read.'); ShowIOerror(i);
  163.     Close(f);
  164.   END;
  165.  
  166.  
  167.   PROCEDURE TypeFile(Fn : STRING);
  168.     { TYPE a file to the screen.  A useless procedure except that it
  169.     demonstrates using a buffer allocated on the heap to be used by RLINE. }
  170.   VAR
  171.     RF      : RFrec;         { Declare RFrec variable. }
  172.     TBuf    : Pointer;
  173.   BEGIN
  174.     ClrScr;
  175.     GetMem(TBuf, BS);        { First, allocate memory for the buffer. }
  176.     rf.init;
  177.  
  178.     with rf do begin
  179.       { Be certain to insert the ^ in TBuf^ when opening the file. }
  180.       i := FOpen(Fn, BS, TBuf^); { try to open the file. }
  181.  
  182.       IF i <> 0 THEN BEGIN     { Was file successfully opened? }
  183.         ShowIOerror(i);
  184.         Halt(1);
  185.       END;
  186.  
  187.       REPEAT
  188.         i := FReadLn(S);   { Attempt to read the next line from the file. }
  189.  
  190.         IF keypressed AND (readkey = ^S) { if user pressed ^S, then pause }
  191.         THEN IF readkey <> #0 THEN ; { the display by forcing a keypress. }
  192.  
  193.         IF i = 0
  194.         THEN WriteLn(S);       { if no error, then display the line. }
  195.  
  196.       UNTIL i <> 0;
  197.       ShowIOerror(i);
  198.       FClose;              { Close the file. }
  199.     END;
  200.   end;
  201.  
  202.   PROCEDURE PositioningTest(Fn : STRING);
  203.   VAR
  204.     NLines, lno : LongInt;
  205.     ch      : Char;
  206.   BEGIN
  207.     ClrScr;
  208.     WriteLn('     Pos    Line     Pos    Line     Pos    Line     Pos    Line     Pos    Line');
  209.     with rf do begin
  210.       i := FOpen(Fn, BS, TBuf);   { Open Fn }
  211.       IF i <> 0 THEN BEGIN
  212.         ShowIOerror(i);
  213.         Halt(1);
  214.       END;
  215.  
  216.       window(1, 2, 80, 25);
  217.       NLines := 0;
  218.       Write(FFilepos:8, NLines:8);
  219.       REPEAT
  220.         i := FReadLn(S);
  221.         IF i = 0 THEN BEGIN
  222.           Inc(NLines);
  223.           Write(FFilepos:8, NLines:8);
  224.         END;
  225.       UNTIL i <> 0;
  226.  
  227.       WriteLn(^j^j^j^j);
  228.       window(1, 21, 80, 25);
  229.  
  230.       REPEAT
  231.         Write('Enter file Position to Seek (-1 to quit): '); ReadLn(lno);
  232.         if lno < 0 then halt;
  233.         i := fseek(lno);
  234.         IF i <> 0 THEN ShowIOerror(i)
  235.         ELSE BEGIN
  236.           i := FRead(ch);
  237.           IF i <> 0 THEN ShowIOerror(i);
  238.           WriteLn('Char is: #', Ord(ch));
  239.           i := fseek(lno);
  240.           IF i <> 0 THEN ShowIOerror(i);
  241.           i := FReadLn(S);
  242.           IF i <> 0 THEN ShowIOerror(i);
  243.           WriteLn(S);
  244.         END;
  245.       UNTIL lno = 10000;
  246.       FClose;
  247.     end;
  248.     window(1, 1, 80, 25);
  249.   END;
  250.  
  251.  
  252. BEGIN
  253.   clrscr;  writeln('Text file prcessor as object test program');
  254.   write('Enter file name ');  readln(fname);
  255.  
  256.   rf.init;
  257.  
  258.   WriteLn;
  259.  
  260.   PrepForTimingTest(fname);
  261.  
  262.   ReadLnTest(fname);
  263.  
  264.   IF ParamCount > 1
  265.   THEN PositioningTest(ParamStr(2))
  266.   ELSE PositioningTest(fname);
  267.  
  268.  
  269. END.
  270.